Project_Notes

EPR: Project Notes

The dataset provide as part of environment reporting legislation requirements in pdf format and has been transposed to an excel format. Detailed information about the program can be found here.

This indicator will be replacing the tire recycling indicator.

Data summary:

There are seven sets of data assessed for this indicator;

• Beverage containers
• Oil
• Tires
• Paint-Flam_Pest (pfp)
• Electical
• Lead-Acid Batteries
• Packaging and Printed Paper (ppp)

BC population data was manually extracted per regional district (2000 - 2018) using the BC Population tool. Data used in the Oil, lubricant, antifreeze etc measure was already summarised to a per capita measure. Raw data is available within the pdf reports if required.

Data will be summarised by 1) tonnage per region per capita and 2) financial estimates will be calculated cost per tonnes per unit type. As not all measures are documented over the same time periods we refined trends from 2014 - 2017.

Work flow:

1. All raw data is extracted from excel worksheets and combined into a three dataframes using the ‘clean.readxl.R’ script. The dataframes are ‘all.finance’, ‘all.units’, ‘all.regions’.

2. Data is then loading into R and inital summaries and exploration is conducted using the ‘01_load.R’ script **. A graphical html output of these analysis can be run using the (‘Project_notes.Rmd’ file)

3. Apon further discussions we decided to concentrate reporting on regional amounts per capita (ie: tonnes per capita). This would be per type and combining all types. This had the advantage of enabling reporting over multiple years where data was available (eg: beverages).

4. To decicepher more detailed data we will contact the data custodians directly.

5. Bob also suggested calculating the cost per tonne of recycling per type to give an equivalent measure for other provinces etc.

Regional data availability

The following recycling types contained weight information (tonnes/kg) at a regional scale ; Beverage (2007-2017) , Electrical (Major Appliance recycling: 2015-2017, Batteries (2010 - 2017), Canadian Electrical Stewardship Association (2011- 2017)), Pharmaceutical (2008 - 2017) and PPP (packaging, printed, paper (2015-2017)). The other measures were collected at a provincial scale (Tires, Lead-Acid Batteries) or are reported in non-compariable unites (no. of items or tubskids) and require further investigation.

We investigated the patterns of recycling per capita for those metrics where comparable data was available (Beverage, Electrical, Pharmaceutical and PPP). It should be noted Pharmeceuticals represent consumable recycling products (i.e an increase in recycling has more complex interpretation)

all.regions <- read_csv(file.path('data','all.regions.csv'))

## Parsed with column specification:
## cols(
##   .default = col_double(),
##   organization = col_character(),
##   type = col_character(),
##   measure = col_character(),
##   regional_district = col_character(),
##   `2000` = col_logical(),
##   `2001` = col_logical(),
##   `2002` = col_logical(),
##   `2003` = col_logical(),
##   `2004` = col_logical(),
##   `2005` = col_logical()
## )

## See spec(...) for full column specifications.

# select the measures where weight is equivalent 
tonnes <- c("Absolute Collection-Weight Collected (Tonnes)-",
            "Absolute collection - Regular products -Weight (kg)-",
            "Absolute collection - batteries (kg)",
            "Estimated Tonnes Collected", "tonnes of ppp",
            "Absolute Collection-Weight Collected (kg)-")

# regions per type for all years 
type.region <- all.regions %>%
  filter(measure %in% tonnes) %>%
  select(-c(organization)) %>%
  group_by(type, measure, regional_district) %>%
  summarise_all(sum, na.rm = TRUE) %>%
  gather("year", "n", 4:length(.)) %>%
  filter(!n == 0) %>%
  mutate(n.kg = ifelse(str_detect(measure,"onnes"), n * 1000, n)) %>%
  group_by(type, regional_district, year) %>%
  summarise(n.kg.sum = sum(n.kg)) %>%
  left_join(pop, by = c("regional_district","year")) %>%
  filter(!regional_district == "Provincial Total") %>%
  mutate(n.kg.pop = n.kg.sum / pop)

## Basic plot one off plots for weight per capita per year
ggplot(type.region, aes(year, n.kg.pop)) +
  facet_wrap(~ type) +
  geom_bar(stat = "identity", position="dodge") +
  labs(title = "Average recycling (kg) per capita",
       x = "Year", y = "weight per capita (kg)") +
  theme(axis.text.x = element_text(angle = 90))

The amount of recycled goods per capita varies greatly with Pharmaceuticals showing very low numbers. Annual changes in recycling over years also suggests rolling up all measures would result in some artificial patterns, unless limited to 2015 - 2017 data only.

We can take the beverage as an example and use this to show regional differences over time.

# calculate the provincial average per year for beverages
bc.kg.per.cap <- type.region %>%
  na.omit() %>%
  filter(type == "bev") %>%
  group_by(type, year) %>%
  summarise(bc_ave = mean(n.kg.pop))

# write a function to plot each of the regions over time for beverages
temp_plots <- function(rdata, district) {
  make_plot <- ggplot () +
    geom_bar(data = rdata, aes(x = year, y = n.kg.pop),stat = "identity") +
    geom_point(data = bc.kg.per.cap, aes(x = year, y = bc_ave), colour = "red") +
    labs(x = "Year", y = "kg per capital") + # Legend text
    ggtitle(paste("Reported Recycling for "
                  , district
                  ,sep = "")) +
    theme_soe() + theme(plot.title = element_text(hjust = 0.5), # Centre title
                        legend.position = "bottom",
                        plot.caption = element_text(hjust = 0)) # L-align caption
  make_plot
}

# Lopo through the regional districts 

names <- unique(type.region$regional_district)
temp_plot_list <- vector(length = length(names), mode = "list")

plots <- for (i in 1:length(names)) {
  district <- names[i]
  rdata <- type.region %>% filter(type == "bev", regional_district == district)
  p <- temp_plots(rdata, district)
  temp_plot_list[[i]] <- p
  ggsave(p, file = paste0("out/", district, ".svg"))
}

## Saving 7 x 5 in image

## Warning: package 'gdtools' was built under R version 3.5.3

## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image
## Saving 7 x 5 in image

reg_dist <- combine_nr_rd() %>%
  rmapshaper::ms_simplify(0.005) %>%
  st_intersection(bc_bound()) %>%
  st_transform(4326) %>%
  group_by(ADMIN_AREA_NAME,ADMIN_AREA_ABBREVIATION) %>%
  summarize()

## Warning: attribute variables are assumed to be spatially constant
## throughout all geometries

reg_dist$ADMIN_AREA_NAME[which(reg_dist$ADMIN_AREA_NAME %in%
                                 c("Comox Valley Regional District", "Strathcona Regional District"))] <- "Comox-Strathcona"

reg_dist %<>%
  group_by(ADMIN_AREA_NAME) %>%
  summarise(do_union = FALSE) %>%
  ungroup() %>%
  st_make_valid() %>%
  st_collection_extract("POLYGON")

### match district names by removing words and hyphenating
reg_dist$ADMIN_AREA_NAME %<>%
  str_replace(" Regional District", "") %>%
  str_replace("Regional District of ", "") %>%
  str_replace("-", " ") %>%
  str_replace("qathet", "Qathet")
#mapview(reg_dist)

reg_dist <- reg_dist %>%
  left_join(type.region, by = c("ADMIN_AREA_NAME" = "regional_district")) %>%
  mutate(regional_district = ADMIN_AREA_NAME)

# need to adjust these labels to kg.per.cap (not %)
labels <- sprintf(
  "<strong>%s (%s%%)</strong>",
  tools::toTitleCase(tolower(reg_dist$regional_district)),
  round(reg_dist$n.kg.pop, 0)
) %>% lapply(htmltools::HTML)

pal <- colorNumeric(palette = "YlGn", domain = reg_dist$n.kg.pop)

# set up popup list
temp_popups <-  leafpop::popupGraph(temp_plot_list, type = "svg")
saveRDS(temp_popups, "out/temp_popups.rds")

popup_options <-  popupOptions(autoPan = TRUE,
                               keepInView = TRUE,
                               closeOnClick = TRUE,
                               autoPanPaddingTopLeft = c(120, 20),
                               autoPanPaddingBottomRight = c(120,20))


leaflet(reg_dist, width = "900px", height = "550px") %>%
  setView(lng = -126.5, lat = 54.5, zoom = 4) %>%
  addProviderTiles("OpenStreetMap.BlackAndWhite",
                   options = providerTileOptions(minZoom = 5, maxZoom = 10)) %>%
  addPolygons(color = "#7f7f7f", weight = 1, smoothFactor = 0.5,
              opacity = 1.0, fillOpacity = 0.6,
              fillColor = ~ pal(n.kg.pop),
              highlightOptions = highlightOptions(fillOpacity = 0.9,
                                                  weight = 2,
                                                  bringToFront = FALSE),
              label = labels,
              labelOptions = labelOptions(direction = "auto",
                                          textsize = "12px"),
              popup = temp_popups,
              popupOptions = popup_options
  ) %>%
  addEasyButton(easyButton(
    icon = htmltools::span('Reset Map'),
    onClick = JS("function(btn, map) {
                 map.closePopup();
                 map.setView({lon: -126.5, lat: 54.5}, 5);
                 // Close labels - they stay stuck open on mobile
                 map.eachLayer(function (layer) {
                 if (layer instanceof L.Polygon) {
                 layer.label.close();
                 }
                 });
                 }"),
    position = "bottomleft", id = "reset-button")) %>%
  addLegend(position = "bottomleft", pal = pal, values = ~n.kg.pop,
            title = htmltools::HTML("Recycled<br/>material<br/>kg per<br/>capita"),
            labFormat = labelFormat(suffix = , between = "", digits = 3))

This figure still needs some work but could provide some discussion on what is possible.

Financial costs

Reporting the financial costs may be difficult due to the variation and non-standrard reporting. Bob suggested reporting on the cost per tonne for a given type of recycling. This provides a standard measure in which multiple provinces could compare in regard to eco-fees and incentive programs.

#unique(all.regions$measure)
tonnes <- c("Absolute Collection-Weight Collected (Tonnes)-",
            "Absolute collection - Regular products -Weight (kg)-",
            "Absolute collection - batteries (kg)",
            "Estimated Tonnes Collected", "tonnes of ppp",
            "Absolute Collection-Weight Collected (kg)-")

# get tonnes per recycling type 
tot.region <- all.regions %>%
  filter(measure %in% tonnes) %>%
  filter(!regional_district == "Provincial Total") %>%
  group_by(organization, type, measure, regional_district) %>%
  summarise_all(sum, na.rm = TRUE) %>%
  gather("year", "n", 5:length(.)) %>%
  filter(!n == 0) %>%
  mutate(n.kg = ifelse(str_detect(measure,"onnes"), n * 1000, n)) %>%
  group_by(organization, type,year) %>%
  summarise(n.kg.sum = sum(n.kg)) 


# get financial details per organization and type   
all.finance <- read_csv(file.path('data','all.finance.csv'))

## Parsed with column specification:
## cols(
##   .default = col_double(),
##   organization = col_character(),
##   type = col_character(),
##   measure = col_character(),
##   regional_district = col_logical()
## )

## See spec(...) for full column specifications.

to.keep = c("Expenditure-Total", "Expenditures", "Revenue-Total","Revenues",
            "Revenue-Total (Including Deposits Charged)",
            "Expenditure-Total (Including Deposits Returned)",
            "Balance (Including Deposits Charged/Returned)" )

fdata <- all.finance %>%
  gather("year", "n", 4:length(.)) %>%
  mutate(n.m = n/1000000) %>%
  group_by(organization, type, measure, year) %>%
  summarise(total.m = sum(n.m,na.rm = TRUE)) %>%
  filter(measure %in% to.keep) %>%
  mutate(measure_consol = ifelse(measure %in%
                                   c("Expenditure-Total","Expenditures",
                                     "Expenditure-Total (Including Deposits Returned)"),"Expenditure",
                                 ifelse(measure %in% c("Revenue-Total","Revenues",
                                                       "Revenue-Total (Including Deposits Charged)"),"Revenue",NA) )) %>%
  filter(measure_consol == "Expenditure")

# calculate cost per tonne
cost.per.tonne <- tot.region %>%
  left_join(fdata) %>%
  select(c(organization, type, year, n.kg.sum, total.m)) %>%
  filter(!is.na(total.m)) %>%
  filter(! total.m == 0) %>%
  mutate(c.p.tonne = total.m * 1000 /(n.kg.sum * 0.001))

## Joining, by = c("organization", "type", "year")

ggplot(cost.per.tonne, aes(x = year, y = c.p.tonne, group = organization))+
  geom_point(aes(colour = type))+
  geom_line(aes(colour = factor(type))) +
  labs(title="Cost ($1,000) per tonne of Recycled material",
     x = "Year", y = "Cost ($1,000) per million dollars (tonnes)") +
  theme(axis.text.x = element_text(angle = 90)) #+  scale_y_log10()

Financial costs are based on total expenditure and tonnes of recycled material. In many cases there is not data available for all organizations contributing to the type of recycling (beverage and electronic). There is no financial data provided from pharmaceuticals, beverage expenditure results are only available for Encorp. Electronics is recorded for two organizations (MMR) and CEAS